home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / xlisp / xlpp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  4.0 KB  |  153 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         xlpp.c
  5. * RCS:          $Header: xlpp.c,v 1.4 91/03/24 22:25:17 mayer Exp $
  6. * Description:  xlisp pretty printer
  7. * Author:       David Michael Betz
  8. * Created:      
  9. * Modified:     Fri Oct  4 04:08:00 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: xlpp.c,v 1.4 91/03/24 22:25:17 mayer Exp $";
  43.  
  44.  
  45. #include "xlisp.h"
  46.  
  47. /* external variables */
  48. extern LVAL s_stdout;
  49. extern int xlfsize;
  50.  
  51. /* local variables */
  52. static int pplevel,ppmargin,ppmaxlen;
  53. static LVAL ppfile;
  54.  
  55. /* xpp - pretty-print an expression */
  56. LVAL xpp()
  57. {
  58.     LVAL expr;
  59.  
  60.     /* get expression to print and file pointer */
  61.     expr = xlgetarg();
  62.     ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
  63.     xllastarg();
  64.  
  65.     /* pretty print the expression */
  66.     pplevel = ppmargin = 0; ppmaxlen = 40;
  67.     pp(expr); ppterpri(ppfile);
  68.  
  69.     /* return nil */
  70.     return (NIL);
  71. }
  72.  
  73. /* pp - pretty print an expression */
  74. LOCAL pp(expr)
  75.   LVAL expr;
  76. {
  77.     if (consp(expr))
  78.     pplist(expr);
  79.     else
  80.     ppexpr(expr);
  81. }
  82.  
  83. /* pplist - pretty print a list */
  84. LOCAL pplist(expr)
  85.   LVAL expr;
  86. {
  87.     int n;
  88.  
  89.     /* if the expression will fit on one line, print it on one */
  90.     if ((n = flatsize(expr)) < ppmaxlen) {
  91.     xlprint(ppfile,expr,TRUE);
  92.     pplevel += n;
  93.     }
  94.  
  95.     /* otherwise print it on several lines */
  96.     else {
  97.     n = ppmargin;
  98.     ppputc('(');
  99.     if (atom(car(expr))) {
  100.         ppexpr(car(expr));
  101.         ppputc(' ');
  102.         ppmargin = pplevel;
  103.         expr = cdr(expr);
  104.     }
  105.     else
  106.         ppmargin = pplevel;
  107.     for (; consp(expr); expr = cdr(expr)) {
  108.         pp(car(expr));
  109.         if (consp(cdr(expr)))
  110.         ppterpri();
  111.     }
  112.     if (expr != NIL) {
  113.         ppputc(' '); ppputc('.'); ppputc(' ');
  114.         ppexpr(expr);
  115.     }
  116.     ppputc(')');
  117.     ppmargin = n;
  118.     }
  119. }
  120.  
  121. /* ppexpr - print an expression and update the indent level */
  122. LOCAL ppexpr(expr)
  123.   LVAL expr;
  124. {
  125.     xlprint(ppfile,expr,TRUE);
  126.     pplevel += flatsize(expr);
  127. }
  128.  
  129. /* ppputc - output a character and update the indent level */
  130. LOCAL ppputc(ch)
  131.   int ch;
  132. {
  133.     xlputc(ppfile,ch);
  134.     pplevel++;
  135. }
  136.  
  137. /* ppterpri - terminate the print line and indent */
  138. LOCAL ppterpri()
  139. {
  140.     xlterpri(ppfile);
  141.     for (pplevel = 0; pplevel < ppmargin; pplevel++)
  142.     xlputc(ppfile,' ');
  143. }
  144.  
  145. /* flatsize - compute the flat size of an expression */
  146. LOCAL int flatsize(expr)
  147.   LVAL expr;
  148. {
  149.     xlfsize = 0;
  150.     xlprint(NIL,expr,TRUE);
  151.     return (xlfsize);
  152. }
  153.